home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Library-2.01 / Interfaces / PACKAGES.lisp < prev    next >
Encoding:
Text File  |  1993-09-16  |  13.3 KB  |  350 lines  |  [TEXT/CCL2]
  1.  
  2. (in-package :traps)             ; 
  3. ; Created: Friday, January 25, 1991 at 11:34 AM
  4. ;     Packages.p
  5. ;     Pascal Interface to the Macintosh Libraries
  6. ; 
  7. ;         Copyright Apple Computer, Inc.    1985-1990
  8. ;         All rights reserved
  9. ; 
  10.  
  11. ;;;;;;;;;;;;;
  12. ;
  13. ; Modification History
  14. ;
  15. ; 04/28/93 mwp Release
  16. ; 08/10/92 bill typo in _NumtoString
  17. ; ------------- 2.0
  18. ; 02/18/92 bill _IUStringOrder is not in rom.
  19. ; ------------- 2.0f2
  20. ; 08/29/91 bill get rid of :invalid-type
  21. ; 08/23/91 bill Missing :NO-TRAP in _IUEqualPString
  22. ;
  23.  
  24. ; $IFC UNDEFINED UsingIncludes
  25. ; $SETC UsingIncludes := 0
  26. ; $ENDC
  27.  
  28. ; $IFC NOT UsingIncludes
  29.  
  30. ; $ENDC
  31.  
  32. ; $IFC UNDEFINED UsingPackages
  33. ; $SETC UsingPackages := 1
  34.  
  35. ; $I+
  36. ; $SETC PackagesIncludes := UsingIncludes
  37. ; $SETC UsingIncludes := 1
  38. ; $IFC UNDEFINED UsingTypes
  39.  
  40. (require-interface 'TYPES)      ; $I $$Shell(PInterfaces)Types.p
  41. ; $ENDC
  42. ; $IFC UNDEFINED UsingStandardFile
  43.  
  44. (require-interface 'STANDARDFILE); $I $$Shell(PInterfaces)StandardFile.p
  45. ; $ENDC
  46. ; $IFC UNDEFINED UsingScript
  47.  
  48. (require-interface 'SCRIPT)     ; $I $$Shell(PInterfaces)Script.p
  49. ; $ENDC
  50. ; $SETC UsingIncludes := PackagesIncludes
  51.  
  52. (defconstant $listMgr 0)        ; list manager
  53. (defconstant $dskInit 2)        ; Disk Initializaton
  54. (defconstant $stdFile 3)        ; Standard File
  55. (defconstant $flPoint 4)        ; Floating-Point Arithmetic
  56. (defconstant $trFunc 5)         ; Transcendental Functions
  57. (defconstant $intUtil 6)        ; International Utilities
  58. (defconstant $bdConv 7)         ; Binary/Decimal Conversion
  59. (defconstant $editionMgr 11)    ; Edition Manager
  60. (defconstant $currSymLead 16)
  61. (defconstant $currNegSym 32)
  62. (defconstant $currTrailingZ 64)
  63. (defconstant $currLeadingZ 128)
  64. (defconstant $zeroCycle 1)      ; 0:00 AM/PM format
  65. (defconstant $longDay 0)        ; day of the month
  66. (defconstant $longWeek 1)       ; day of the week
  67. (defconstant $longMonth 2)      ; month of the year
  68. (defconstant $longYear 3)       ; year
  69. (defconstant $supDay 1)         ; suppress day of month
  70. (defconstant $supWeek 2)        ; suppress day of week
  71. (defconstant $supMonth 4)       ; suppress month
  72. (defconstant $supYear 8)        ; suppress year
  73. (defconstant $dayLdingZ 32)
  74. (defconstant $mntLdingZ 64)
  75. (defconstant $century 128)
  76. (defconstant $secLeadingZ 32)
  77. (defconstant $minLeadingZ 64)
  78. (defconstant $hrLeadingZ 128)
  79.  
  80. ;  Date Orders 
  81. (defconstant $mdy 0)
  82. (defconstant $dmy 1)
  83. (defconstant $ymd 2)
  84. (defconstant $myd 3)
  85. (defconstant $dym 4)
  86. (defconstant $ydm 5)
  87.  
  88. (defconstant $verUS 0)
  89. (defconstant $verFrance 1)
  90. (defconstant $verBritain 2)
  91. (defconstant $verGermany 3)
  92. (defconstant $verItaly 4)
  93. (defconstant $verNetherlands 5)
  94. (defconstant $verFrBelgiumLux 6);  French for Belgium & Luxembourg 
  95. (defconstant $verSweden 7)
  96. (defconstant $verSpain 8)
  97. (defconstant $verDenmark 9)
  98. (defconstant $verPortugal 10)
  99. (defconstant $verFrCanada 11)
  100. (defconstant $verNorway 12)
  101. (defconstant $verIsrael 13)
  102. (defconstant $verJapan 14)
  103. (defconstant $verAustralia 15)
  104. (defconstant $verArabic 16)     ;  synonym for verArabia 
  105. (defconstant $verFinland 17)
  106. (defconstant $verFrSwiss 18)    ;  French Swiss 
  107. (defconstant $verGrSwiss 19)    ;  German Swiss 
  108. (defconstant $verGreece 20)
  109. (defconstant $verIceland 21)
  110. (defconstant $verMalta 22)
  111. (defconstant $verCyprus 23)
  112. (defconstant $verTurkey 24)
  113. (defconstant $verYugoCroatian 25);  Croatian system for Yugoslavia 
  114. (defconstant $verIndiaHindi 33) ;  Hindi system for India 
  115. (defconstant $verPakistan 34)
  116. (defconstant $verLithuania 41)
  117. (defconstant $verPoland 42)
  118. (defconstant $verHungary 43)
  119. (defconstant $verEstonia 44)
  120. (defconstant $verLatvia 45)
  121. (defconstant $verLapland 46)
  122. (defconstant $verFaeroeIsl 47)
  123. (defconstant $verIran 48)
  124. (defconstant $verRussia 49)
  125. (defconstant $verIreland 50)    ;  English-language version for Ireland 
  126. (defconstant $verKorea 51)
  127. (defconstant $verChina 52)
  128. (defconstant $verTaiwan 53)
  129. (defconstant $verThailand 54)
  130. (defconstant $minCountry #$verus)
  131. (defconstant $maxCountry #$verthailand)
  132.  
  133. ; Obsolete region code names, kept for backward compatibility
  134. (defconstant $verBelgiumLux 6)  ; (use verFrBelgiumLux instead, less ambiguous)
  135. (defconstant $verArabia 16)
  136. (defconstant $verYugoslavia 25) ; (use verYugoCroatian instead, less ambiguous)
  137. (defconstant $verIndia 33)      ; (use verIndiaHindi instead, less ambiguous) 
  138.  
  139. ; special ScriptCode values
  140. (defconstant $iuSystemScript -1);  system script 
  141. (defconstant $iuCurrentScript -2);  current script 
  142.  
  143. ; special LangCode values
  144. (defconstant $iuSystemCurLang -2);  current (itlbLang) lang for system script 
  145. (defconstant $iuSystemDefLang -3);  default (table) lang for system script 
  146. (defconstant $iuCurrentCurLang -4);  current (itlbLang) lang for current script 
  147. (defconstant $iuCurrentDefLang -5);  default lang for current script 
  148. (defconstant $iuScriptCurLang -6);  current (itlbLang) lang for specified script 
  149. (defconstant $iuScriptDefLang -7);  default language for a specified script 
  150.  
  151. ; table selectors for IUGetItlTable
  152. (defconstant $iuWordSelectTable 0)
  153. (defconstant $iuWordWrapTable 1)
  154. (defconstant $iuNumberPartsTable 2)
  155. (defconstant $iuUnTokenTable 3)
  156. (defconstant $iuWhiteSpaceList 4)
  157.  
  158. (def-mactype :dateform (find-mactype :unsigned-byte))
  159. (defconstant $shortDate 0)
  160. (defconstant $longDate 1)
  161. (defconstant $abbrevDate 2)
  162.  
  163. (def-mactype :intl0ptr (find-mactype :pointer))
  164. (def-mactype :intl0hndl (find-mactype :handle))
  165. (defrecord (Intl0Rec :handle) 
  166.    (decimalPt :character)       ; decimal point character
  167.    (thousSep :character)        ; thousands separator
  168.    (listSep :character)         ; list separator
  169.    (currSym1 :character)        ; currency symbol
  170.    (currSym2 :character)
  171.    (currSym3 :character)
  172.    (currFmt :unsigned-byte)     ; currency format
  173.    (dateOrder :unsigned-byte)   ; order of short date elements
  174.    (shrtDateFmt :unsigned-byte) ; short date format
  175.    (dateSep :character)         ; date separator
  176.    (timeCycle :unsigned-byte)   ; 0 if 24-hour cycle, 255 if 12-hour
  177.    (timeFmt :unsigned-byte)     ; time format
  178.    (mornStr :ostype)            ; trailing string for first 12-hour cycle
  179.    (eveStr :ostype)             ; trailing string for last 12-hour cycle
  180.    (timeSep :character)         ; time separator
  181.    (time1Suff :character)       ; trailing string for 24-hour cycle
  182.    (time2Suff :character)
  183.    (time3Suff :character)
  184.    (time4Suff :character)
  185.    (time5Suff :character)
  186.    (time6Suff :character)
  187.    (time7Suff :character)
  188.    (time8Suff :character)
  189.    (metricSys :unsigned-byte)   ; 255 if metric, 0 if not
  190.    (intl0Vers :signed-integer)  ; version information
  191.    )
  192.  
  193. (def-mactype :intl1ptr (find-mactype :pointer))
  194. (def-mactype :intl1hndl (find-mactype :handle))
  195. (defrecord (Intl1Rec :handle) 
  196.    (days (:array (:string 15) 7)); day names
  197.    (months (:array (:string 15) 12)); month names
  198.    (suppressDay :unsigned-byte) ; 0 for day name, 255 for none
  199.    (lngDateFmt :unsigned-byte)  ; order of long date elements
  200.    (dayLeading0 :unsigned-byte) ; 255 for leading 0 in day number
  201.    (abbrLen :unsigned-byte)     ; length for abbreviating names
  202.    (st0 :ostype)                ; strings for long date format
  203.    (st1 :ostype)
  204.    (st2 :ostype)
  205.    (st3 :ostype)
  206.    (st4 :ostype)
  207.    (intl1Vers :signed-integer)  ; version information
  208.    (localRtn (:array :signed-integer 1)); routine for localizing string comparison
  209.    )
  210.  
  211.  
  212. (deftrap _initpack ((packid :signed-integer))
  213.    nil
  214.    (:stack-trap #xA9E5))
  215.  
  216. (deftrap _initallpacks nil
  217.    nil
  218.    (:stack-trap #xA9E6))
  219.  
  220.  
  221. (deftrap _iugetintl ((theid :signed-integer))
  222.    (:stack :handle)
  223.    (:stack-trap #xA9ED theid (6 :signed-integer)))
  224.  
  225. (deftrap _iusetintl ((refnum :signed-integer) (theid :signed-integer) (intlhandle :handle))
  226.    nil
  227.    (:stack-trap #xA9ED refnum theid intlhandle (8 :signed-integer)))
  228.  
  229. (deftrap _iudatestring ((datetime :signed-long) (longflag :unsigned-byte) (result (:pointer (:string 255))))
  230.    nil
  231.    (:stack-trap #xA9ED datetime longflag result (0 :signed-integer)))
  232.  
  233. (deftrap _iudatepstring ((datetime :signed-long) (longflag :unsigned-byte) (result (:pointer (:string 255))) (intlhandle :handle))
  234.    nil
  235.    (:stack-trap #xA9ED datetime longflag result intlhandle (14 :signed-integer)))
  236.  
  237. (deftrap _iutimestring ((datetime :signed-long) (wantseconds :boolean) (result (:pointer (:string 255))))
  238.    nil
  239.    (:stack-trap #xA9ED datetime wantseconds result (2 :signed-integer)))
  240.  
  241. (deftrap _iutimepstring ((datetime :signed-long) (wantseconds :boolean) (result (:pointer (:string 255))) (intlhandle :handle))
  242.    nil
  243.    (:stack-trap #xA9ED datetime wantseconds result intlhandle (16 :signed-integer)))
  244.  
  245. (deftrap _iumetric nil
  246.    (:stack :boolean)
  247.    (:stack-trap #xA9ED (4 :signed-integer)))
  248.  
  249.  
  250. (deftrap _iumagstring ((aptr :pointer) (bptr :pointer) (alen :signed-integer) (blen :signed-integer))
  251.    (:stack :signed-integer)
  252.    (:stack-trap #xA9ED aptr bptr alen blen (10 :signed-integer)))
  253.  
  254. (deftrap _iumagidstring ((aptr :pointer) (bptr :pointer) (alen :signed-integer) (blen :signed-integer))
  255.    (:stack :signed-integer)
  256.    (:stack-trap #xA9ED aptr bptr alen blen (12 :signed-integer)))
  257.  
  258. (deftrap _iucompstring ((astr (:string 255)) (bstr (:string 255)))
  259.    (:no-trap :signed-integer)
  260.    (:no-trap (gopmag 10 astr bstr)))
  261.  
  262. (deftrap _iuequalstring ((astr (:string 255)) (bstr (:string 255)))
  263.    (:no-trap :signed-integer)
  264.    (:no-trap (gopmag 12 astr bstr)))
  265.  
  266. (deftrap _stringtonum ((thestring (:string 255)) (thenum (:pointer :signed-long)))
  267.    nil
  268.    (:no-trap (%put-long thenum (ccl::%gen-trap #xA9EE :a0 thestring :word 1 :d0))))
  269.  
  270. (deftrap _numtostring ((thenum :signed-long) (thestring (:pointer (:string 255))))
  271.    nil
  272.    (:no-trap (ccl::%gen-trap #xA9EE :d0 thenum :a0 thestring :word 0)))
  273.  
  274. (deftrap _iuldatestring ((datetime (:pointer :longdatetime)) (longflag :unsigned-byte) (result (:pointer (:string 255))) (intlhandle :handle))
  275.    nil
  276.    (:stack-trap #xA9ED datetime longflag result intlhandle (20 :signed-integer)))
  277.  
  278. (deftrap _iultimestring ((datetime (:pointer :longdatetime)) (wantseconds :boolean) (result (:pointer (:string 255))) (intlhandle :handle))
  279.    nil
  280.    (:stack-trap #xA9ED datetime wantseconds result intlhandle (22 :signed-integer)))
  281.  
  282. (deftrap _iuclearcache nil
  283.    nil
  284.    (:stack-trap #xA9ED (24 :signed-integer)))
  285.  
  286. (deftrap _iumagpstring ((aptr :pointer) (bptr :pointer) (alen :signed-integer) (blen :signed-integer) (itl2handle :handle))
  287.    (:stack :signed-integer)
  288.    (:stack-trap #xA9ED aptr bptr alen blen itl2handle (26 :signed-integer)))
  289.  
  290. (deftrap _iumagidpstring ((aptr :pointer) (bptr :pointer) (alen :signed-integer) (blen :signed-integer) (itl2handle :handle))
  291.    (:stack :signed-integer)
  292.    (:stack-trap #xA9ED aptr bptr alen blen itl2handle (28 :signed-integer)))
  293.  
  294. (deftrap _iucomppstring ((astr (:string 255)) (bstr (:string 255)) (itl2handle :handle))
  295.    (:no-trap :signed-integer)
  296.    (:no-trap (gopmagp 26 astr bstr itl2handle)))
  297.  
  298. (deftrap _iuequalpstring ((astr (:string 255)) (bstr (:string 255)) (itl2handle :handle))
  299.    (:no-trap :signed-integer)
  300.   (:no-trap (gopmagp 28 astr bstr itl2handle)))
  301.  
  302. (deftrap _iuscriptorder ((script1 :signed-integer) (script2 :signed-integer))
  303.    (:stack :signed-integer)
  304.    (:stack-trap #xA9ED script1 script2 (30 :signed-integer)))
  305.  
  306. (deftrap _iulangorder ((language1 :signed-integer) (language2 :signed-integer))
  307.    (:stack :signed-integer)
  308.    (:stack-trap #xA9ED language1 language2 (32 :signed-integer)))
  309.  
  310. (deftrap _iutextorder ((aptr :pointer) (bptr :pointer) (alen :signed-integer) (blen :signed-integer) (ascript :signed-integer) (bscript :signed-integer) (alang :signed-integer) (blang :signed-integer))
  311.    (:stack :signed-integer)
  312.    (:stack-trap #xA9ED aptr bptr alen blen ascript bscript alang blang (34 :signed-integer)))
  313.  
  314. #|
  315. (deftrap _iustringorder ((astr (:string 255)) (bstr (:string 255)) (ascript :signed-integer) (bscript :signed-integer) (alang :signed-integer) (blang :signed-integer))
  316.   (:no-trap :signed-integer)
  317.   (:no-trap (iustringorder pstr0 pstr0 ascript bscript alang blang)))
  318. |#
  319.  
  320. (deftrap _iugetitltable ((script :signed-integer) (tablecode :signed-integer) (itlhandle (:pointer :handle)) (offset (:pointer :signed-long)) (length (:pointer :signed-long)))
  321.    nil
  322.    (:stack-trap #xA9ED script tablecode itlhandle offset length (36 :signed-integer)))
  323.  
  324. ; $ENDC                         ;  UsingPackages 
  325.  
  326. ; $IFC NOT UsingIncludes
  327.  
  328. ; $ENDC
  329.  
  330.  
  331. (export '($abbrevdate $longdate $shortdate $iuwhitespacelist $iuuntokentable
  332.           $iunumberpartstable $iuwordwraptable $iuwordselecttable
  333.           $iuscriptdeflang $iuscriptcurlang $iucurrentdeflang $iucurrentcurlang
  334.           $iusystemdeflang $iusystemcurlang $iucurrentscript $iusystemscript
  335.           $verindia $veryugoslavia $verarabia $verbelgiumlux $maxcountry
  336.           $mincountry $verthailand $vertaiwan $verchina $verkorea $verireland
  337.           $verrussia $veriran $verfaeroeisl $verlapland $verlatvia $verestonia
  338.           $verhungary $verpoland $verlithuania $verpakistan $verindiahindi
  339.           $veryugocroatian $verturkey $vercyprus $vermalta $vericeland
  340.           $vergreece $vergrswiss $verfrswiss $verfinland $verarabic
  341.           $veraustralia $verjapan $verisrael $vernorway $verfrcanada
  342.           $verportugal $verdenmark $verspain $versweden $verfrbelgiumlux
  343.           $vernetherlands $veritaly $vergermany $verbritain $verfrance $verus
  344.           $ydm $dym $myd $ymd $dmy $mdy $hrleadingz $minleadingz $secleadingz
  345.           $century $mntldingz $dayldingz $supyear $supmonth $supweek $supday
  346.           $longyear $longmonth $longweek $longday $zerocycle $currleadingz
  347.           $currtrailingz $currnegsym $currsymlead $editionmgr $bdconv $intutil
  348.           $trfunc $flpoint $stdfile $dskinit $listmgr))
  349. (provide-interface 'PACKAGES)
  350.